home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_100 / 122_01 / pistol.pas < prev    next >
Pascal/Delphi Source File  |  1985-08-19  |  42KB  |  1,749 lines
  1. (*
  2. *********************************************************
  3. *                            *
  4. * PISTOL-Portably Implemented Stack Oriented Language    *
  5. *            Version 1.3            *
  6. * (C) 1982 by    Ernest E. Bergmann            *
  7. *        Physics, Building #16            *
  8. *        Lehigh Univerisity            *
  9. *        Bethlehem, Pa. 18015            *
  10. *                            *
  11. * Permission is hereby granted for all reproduction and    *
  12. * distribution of this material provided this notice is    *
  13. * is included.                        *
  14. *                            *
  15. *********************************************************
  16. *)
  17. PROGRAM PISTOL(INPUT:/);
  18. (*DECEMBER 22, 1981 --FOR BEST PERFORMANCE IN PASCAL,
  19.     THIS PROGRAM SHOULD BE EDITED TO MAKE FULL USE
  20.     OF THE OPTIONS, USER=0,W=1,S=1,CSTEP=1,L=1,R=1
  21.     AND STRINGSMIN=-1 *)
  22.  
  23. LABEL 99;
  24. CONST
  25. VERSION=13;(*10* THE VERSION NUMBER,READABLE BY USER*)
  26. USER=0;(*DISPLACEMENT FOR USER'S RAM AREA; IT SHOULD
  27.     BE CHANGED TO SIMPLIFY ADDRESS CALCULATION IN
  28.     ASSEMBLY CODE IMPLEMENTATIONS*)
  29. W=1;(*RAM ADDRESS INCREMENT SIZE; TYPICALLY WOULD BE
  30.     2 OR 4 FOR 8-BIT MICROS AND OTHER BYTE ADDRESSABLE
  31.     MACHINES*)
  32. R=1;(*INCREMENT SIZE FOR RSTACK,HIDDEN FROM USER*)
  33. S=1;(*INCREMENT SIZE FOR (PARAMETER) STACK,HIDDEN*)
  34. STACKMIN=0;(*WHATEVER IS CONVENIENT,HIDDEN FROM USER*)
  35. MSTACKMIN=-3;(*STACKMIN-S*3*)
  36. PSTACKMAX=203;(*STACKMAX+S*3*)
  37. STACKMAX=200;(*STACKMIN+SSIZE*S*)
  38. LSTACKMIN=0;(*WHATEVER IS CONVENIENT,HIDDEN FROM USER*)
  39. L=1;(*LSTACK INCREMENT,HIDDEN FROM USER*)
  40. LSTACKMAX=30;(*LSTACKMIN+LSIZE*L*)
  41. CSTACKMIN=0;(*WHATEVER IS CONVENIENT*)
  42. CSTEP=1;(*CSTACK INCREMENT*)
  43. CSTACKMAX=30;(*CSTACKMIN+CSIZE*CSTEP*)
  44. NUMINSTR=75;
  45. RAMMIN=-57(*USER-W*57,OR LOWER,READABLE*);
  46. MAXORD=127;(*7 BIT FOR DEC-20,READABLE*)
  47. RAMMAX=8000;(*=RAMMIN+W*4000 AT LEAST,READABLE BY USER*)
  48. COMPBUF=7000;(*=RAMMAX-W*200,OR LOWER,READABLE BY USER*)
  49. SSIZE=200;(*READABLE BY USER*)
  50. RSIZE=30;(*READABLE BY USER*)
  51. RSTACKMIN=0;(*ARBITRARY,HIDDEN*)
  52. RSTACKMAX=30;(*RSTACKMIN+R*RSIZE*)
  53. LSIZE=30;(*READABLE BY USER*)
  54. CSIZE=30;(*READABLE BY USER*)
  55. (*VOCABULARY STACK IS LOCATED IN RAM*)
  56. VSIZE=8;(*VOCAB STACK,READABLE BY USER*)
  57. VBASE=1;(*=USER +W,READABLE BY USER*)
  58. STRINGSMIN=7000(*READABLE BY USER*);
  59. SYNTAXBASE=7001(*STRINGSMIN+1*);
  60. STRINGSMAX=12000;(*STRINGSMIN+ 3000..5000 INTENDED FOR EDIT AREA *)
  61. MAXLINNO=300;(*MAX # OF LINES POSSIBLE IN EDIT BUFFER,
  62.         READABLE BY USER*)
  63. LINEBUF=9800;(*STRINGSMIN+2800,READABLE BY USER*)
  64. CHKLMT=20(*SIZE OF CHECK STACK,READABLE BY USER*);
  65. FALS=0; TRU=-1;
  66.  
  67. (* OPCODES WHOSE VALUES ARE NOT CRITICAL; THEY MUST BE
  68.    UNIQUE AND RECOGNIZEABLE BY KERNQ, AND SEPERABLE
  69.    INTO PINT1 AND PINT2 *)
  70.     PSEMICOLON=0;
  71.     WSTORE=1;
  72.     TIMES=2;
  73.     PLUS=3;
  74.     SUBTRACT=4;
  75.     DIVMOD=5;
  76.     PIF=6;
  77.     WAT=7;
  78.     ABRT=8;
  79.     SP=9;
  80.     LOAD=10;
  81.     PELSE=11;
  82.     WRD=12;
  83.     RP=13;
  84.     DROPOP=14;
  85.     PUSER=15;
  86.     EXEC=16;
  87.     EXITOP=17;
  88.     LIT=18;
  89.     STRLIT=19;
  90.     RPOP=20;
  91.     SWP=21;
  92.     TYI=22;
  93.     TYO=23;
  94.     RPSH=24;
  95.     SEMICF=25;
  96.     RAT=26;
  97.     COMPME=27;
  98.     COMPHERE=28;
  99.     DOLLARC=29;
  100.     COLON=30;
  101.     SEMICOLON=31;
  102.     IFOP=32;
  103.     ELSEOP=33;
  104.     THENOP=34;
  105.     DOOP=35;
  106.     LOOPOP=36;
  107.     BEGINOP=37;
  108.     ENDOP=38;
  109.     REPET=39;
  110.     PERCENT=40;
  111.     PDOLLAR=41;
  112.     PCOLON=42;
  113.     CASAT=43;
  114.     PDOOP=44;
  115.     PPLOOP=45;
  116.     PLLOOP=46;
  117.     CAT=47;
  118.     CSTORE=48;
  119.     PLOOP=49;
  120.     GT=50;
  121.     SEMIDOL=51;
  122.     KRNQ=52;
  123.     (* OPCODES 53,54 NOT USED AT MOMENT *)
  124.     SAT=55;
  125.     FINDOP=56;
  126.     LISTFIL=57;
  127.     (* OPCODE 58 MOMENTARILY UNUSED *)
  128.     LAT=59;
  129.     OFCAS=60;
  130.     CCOLON=61;
  131.     SEMICC=62;
  132.     NDCAS=63;
  133.     POFCAS=64;
  134.     PCCOL=65;
  135.     PSEMICC=66;
  136.     GTLIN=67;
  137.     WORD=68;
  138.     OPENR=69;
  139.     OPENW=70;
  140.     READL=71;
  141.     WRITL=72;
  142.     CORDMP=73;
  143.     RESTOR=74;
  144. (* END OF OPCODE DECLARATIONS *)
  145.  
  146.  
  147.  
  148.  
  149. TYPE DALFA = PACKED ARRAY[1..20] OF CHAR;
  150.  
  151. IMAGE=    RECORD
  152.     STRINGS:PACKED ARRAY[STRINGSMIN..STRINGSMAX] OF CHAR;
  153.     RAM:ARRAY[RAMMIN..RAMMAX] OF INTEGER;
  154.     END(*RECORD*);
  155.  
  156. IMFILE=FILE OF IMAGE;
  157.  
  158. VAR
  159. IMAGENAME,NAMEIN,NAMOUT,INFIL1,LISTNAME,NULLNAME:DALFA;
  160. IP:INTEGER;(*INSTRUCTION POINTER*)
  161. INSTR:INTEGER;(*INSTRUCTION CURRENTLY EXECUTED BY INTERPRET*)
  162. SAVINSTR:INTEGER(*SAVES INSTR DURING TRACING*);
  163. SAVLEVEL:INTEGER(*SAVES LEVEL DURING TRACING*);
  164. TEMP: INTEGER;
  165. EDIN,EDOUT,LDFIL1,LIST,OUTPUT:TEXT;
  166. SAVEFILE:IMFILE;
  167. NOPEN,FEOF,UNDFLO,OVFLO,SYNT,ID,REDEF,ADDR,VAL,I,DIVBY0:INTEGER;
  168. CONVERTED:BOOLEAN;
  169. C:CHAR;
  170.  
  171.  
  172. (*    RAM[RAMMIN...]:
  173.     RAM[USER-W*57]=MAXLINNO
  174.     RAM[USER-W*56]=CHKLMT
  175.     RAM[USER-W*55]=RAMMIN
  176.     RAM[USER-W*54]=STRINGSMIN
  177.     RAM[USER-W*53]=**TO BE RECYCLED**
  178.     RAM[USER-W*52]=ABORT PATCH
  179.     RAM[USER-W*51]=USER CONVERSION PATCH
  180.     RAM[USER-W*50]=PROMPT PATCH
  181.     RAM[USER-W*49]=STRINGSMAX
  182.     RAM[USER-W*48]=VBASE
  183.     RAM[USER-W*47]=VSIZE
  184.     RAM[USER-W*46]=CSIZE
  185.     RAM[USER-W*45]=LSIZE
  186.     RAM[USER-W*44]=RSIZE
  187.     RAM[USER-W*43]=SSIZE
  188.     RAM[USER-W*42]=LINEBUF
  189.     RAM[USER-W*41]=COMPBUF
  190.     RAM[USER-W*40]=RAMMAX
  191.     RAM[USER-W*39]=MAXORD  =127 FOR 7 BIT CHARACTER REP.
  192.     RAM[USER-W*38]=MAXINT
  193.     RAM[USER-W*37]=**TO BE RECYCLED**
  194.     RAM[USER-W*36]=VERSION =11 (1.1)
  195.     RAM[USER-W*35]=SESSION DONE BOOLEAN
  196.     RAM[USER-W*34]=^PISTOL<
  197.     RAM[USER-W*33]=0(FOR PISTOL)
  198.     RAM[USER-W*32]=^VSTACK(CONTEXT)
  199.     FILE STATUS: NEGATIVE VALUE MEANS EOF FOR INPUT
  200.             OR FILE OPENED FOR WRITE;
  201.             MAGNETUDE OF VALUE=LINES OF TEXT
  202.             TRANSFERED SINCE FILE WAS OPENED.
  203.     RAM[USER-W*31]=STATUS FOR EDOUT
  204.     RAM[USER-W*30]=STATUS FOR EDIN
  205.     RAM[USER-W*29]=STATUS FOR LDFIL1
  206.  
  207.     RAM[USER-W*28]=#GETLINE ADDRESS
  208.     RAM[USER-W*27]=TAB SIZE, NORMALLY 8
  209.     RAM[USER-W*26]=TRACE PATCH ADDRESS
  210.     RAM[USER-W*25]=ENDCASE PATCH ADDRESS
  211.     RAM[USER-W*24]=COLUMN
  212.     RAM[USER-W*23]=TERMINAL WIDTH
  213.     RAM[USER-W*22]=# OF LINES OUTPUT TO CONSOLE
  214.     RAM[USER-W*21]=TERMINAL PAGE,MAX # OF LINES
  215.     RAM[USER-W*20]=COMPILE-END-PATCH
  216.             USED TO SHOW CONTENTS OF COMPILE BUFFER
  217.     RAM[USER-W*19]=TRACE BOOLEAN AND LEVEL
  218.     RAM[USER-W*18]=HEAD OF TOKEN IN LINE
  219.     RAM[USER-W*17]=RAISE LC-->UC BOOLEAN
  220.     RAM[USER-W*16]=LINELENGTH
  221.     RAM[USER-W*15]=NEXTCH POINTER
  222.     RAM[USER-W*14]=CONSOLE OUT BOOLEAN
  223.     RAM[USER-W*13]=ECHO BOOLEAN
  224.     RAM[USER-W*12]=LIST BOOLEAN
  225.     RAM[USER-W*11]=INPUT FILE
  226.     RAM[USER-W*10..-7]=SYS TEMPS
  227.     RAM[USER-W*6]=CURRENT    (POINTER)
  228.     RAM[USER-W*5]=OLD END OF STRINGS
  229.     RAM[USER-W*4]=CURRENT END OF STRINGS
  230.     RAM[USER-W*3]=.D
  231.     RAM[USER-W*2]=.C
  232.     RAM[USER-W*1]=RADIX
  233.     RAM[VBASE..VBASE+VSIZE]=VOCABULARY STACK
  234.     RAM[VBASE+VSIZE..NUMINSTR]=NOT USED HERE *)
  235. MEMORY:IMAGE;
  236. STKPTR:INTEGER;
  237. RPTR:INTEGER;
  238. LPTR:INTEGER;
  239. CPTR:INTEGER;
  240.  
  241. (*    STRINGS[STRINGSMIN] RADIX INDICATOR
  242.     STRINGS[SYNTAXBASE] DEPTH OF NESTING &
  243.             CHECKSTACK POINTER    *)
  244. RSTACK:ARRAY[RSTACKMIN..RSTACKMAX] OF INTEGER;
  245. STACK:ARRAY[MSTACKMIN..PSTACKMAX] OF INTEGER;
  246. LSTACK:ARRAY[LSTACKMIN..LSTACKMAX] OF INTEGER;
  247. CSTACK:ARRAY[CSTACKMIN..CSTACKMAX] OF INTEGER;
  248. (* VSTACK LOCATED IN LOW RAM *)
  249.  
  250. PROCEDURE ABORT;
  251. FORWARD;(*RECURSION NEEDED HERE ONLY FOR CARRET,BELOW:*)
  252.  
  253.  
  254. PROCEDURE CARRET(*OUTPUTS A CR-LF SEQUENCE*);
  255. BEGIN
  256. WITH MEMORY DO BEGIN
  257.     IF RAM[USER-W*14]<>FALS
  258.     THEN    BEGIN
  259.         RAM[USER-W*22]:=RAM[USER-W*22]+1;
  260.         IF RAM[USER-W*22]=RAM[USER-W*21]
  261.         THEN    BEGIN
  262.             READLN(INPUT);
  263.             READ(INPUT,C);
  264.             RAM[USER-W*22]:=0;
  265.             IF (C='Q') OR (C='q') THEN ABORT;
  266.             END;
  267.         RAM[USER-W*24]:=0;
  268.         WRITELN(OUTPUT);
  269.         END;
  270.     IF RAM[USER-W*12]<>FALS THEN WRITELN(LIST);
  271. END(*WITH MEMORY*);
  272. END(*CARRET*);
  273.  
  274.  
  275. PROCEDURE SPACES(NUM:INTEGER);
  276. FORWARD; (* NEEDED BY TAB, BELOW: *)
  277.  
  278. PROCEDURE TAB;
  279.     BEGIN
  280. WITH MEMORY DO BEGIN
  281.     IF RAM[USER-W*27]>0
  282.     THEN SPACES(RAM[USER-W*27]-(RAM[USER-W*24] MOD RAM[USER-W*27]));
  283. END(*WITH MEMORY*);
  284.     END(*TAB*);
  285.  
  286. PROCEDURE CHOUT(CH:CHAR);
  287. (* OUTPUTS A CHARACTER*)
  288. BEGIN
  289. WITH MEMORY DO BEGIN
  290.     IF CH=CHR(13) THEN CARRET
  291.     ELSE IF CH=CHR(9) THEN TAB
  292.     ELSE    BEGIN
  293.         IF RAM[USER-W*24]=RAM[USER-W*23] THEN CARRET;
  294.         RAM[USER-W*24]:=RAM[USER-W*24]+1;
  295.         IF RAM[USER-W*14]<>FALS THEN WRITE(OUTPUT,CH);
  296.         IF RAM[USER-W*12]<>FALS THEN WRITE(LIST,CH);
  297.         END
  298. END(*WITH MEMORY*);
  299. END(*CHOUT*);
  300.  
  301. PROCEDURE SPACES;
  302.     BEGIN
  303.     WHILE NUM>0 DO
  304.         BEGIN
  305.         CHOUT(' ');
  306.         NUM:=NUM-1;
  307.         END(*WHILE*)
  308.     END(*SPACES*);
  309.  
  310.  
  311. PROCEDURE MESSAGE(ST:INTEGER);
  312.     BEGIN
  313. WITH MEMORY DO BEGIN
  314.     IF ORD(STRINGS[ST])>0 THEN
  315.         BEGIN
  316.         RAM[USER-W*10]:=ST+ORD(STRINGS[ST]);(*LAST*)
  317.         REPEAT
  318.             ST:=ST+1;
  319.             CHOUT(STRINGS[ST]);
  320.         UNTIL ST=RAM[USER-W*10];
  321.         END(*IF*)
  322. END(*WITH MEMORY*);
  323.     END(*MESSAGE*);
  324.  
  325. PROCEDURE INTERPRET(I:INTEGER);
  326.     FORWARD;(*NEEDED IN ABORT,PROMPT